home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0188.ZIP / ITRMWIND.INC < prev    next >
Text File  |  1985-02-20  |  9KB  |  304 lines
  1. { A set of routines for text window manipulation
  2.   By Bela Lubkin
  3.   Borland International Technical Support
  4.   1/10/85
  5.   2/20/85 Bug fix: DisposeWindow left a bunch of junk on the heap, causing
  6.     uncontrolled growth!
  7.   (For PC-DOS Turbo Pascal version 2 or greater)
  8. }
  9. Type
  10.   XTCoord=1..80;   { X Text coordinate }
  11.   YTCoord=1..25;   { Y Text coordinate }
  12.   XTCoord0=0..80;  { X Text coordinate + 0 for nothing }
  13.   YTCoord0=0..25;  { Y Text coordinate + 0 for nothing }
  14.   WindowRec=Record
  15.               XSize: XTCoord;
  16.               YSize: YTCoord;
  17.               XPosn: XTCoord;
  18.               YPosn: YTCoord;
  19.               Contents: Array [0..1999] Of Integer;
  20.             End;
  21.   WindowPtr=^WindowRec;
  22.  
  23. Const
  24.   ScreenBase: Integer = $B800;
  25.  
  26. Var
  27.   WindowXLo: XTCoord;
  28.   WindowYLo: YTCoord;
  29.   WindowXHi: XTCoord;
  30.   WindowYHi: YTCoord;
  31.  
  32. Procedure TurboWindow(XL: XTCoord; YL: YTCoord; XH: XTCoord; YH: YTCoord);
  33. { This procedure provides an entry to Turbo's built in Window procedure }
  34.   Begin
  35.     Window(XL,YL,XH,YH);
  36.   End;
  37.  
  38. Procedure Window(XL: XTCoord; YL: YTCoord; XH: XTCoord; YH: YTCoord);
  39. { This procedure replaces Turbo's built in Window procedure.  It calls the
  40.   original Window procedure, and also keeps track of the window boundaries. }
  41.  
  42.   Begin
  43.     TurboWindow(XL,YL,XH,YH);
  44.     WindowXLo:=XL;
  45.     WindowYLo:=YL;
  46.     WindowXHi:=XH;
  47.     WindowYHi:=YH;
  48.   End;
  49.  
  50. Function SaveWindow(XLow: XTCoord; YLow: YTCoord;
  51.                     XHigh: XTCoord; YHigh:YTCoord): WindowPtr;
  52. { Allocate a WindowRec of the precise size needed to save the window, then
  53.   fill it with the text that is in the window XLow..XHigh, YLow..YHigh.
  54.   Return a pointer to this WindowRec. }
  55.  
  56.   Var
  57.     SW: WindowPtr;
  58.     I: Integer;
  59.     XS: XTCoord;
  60.     YS: YTCoord;
  61.  
  62.   Begin
  63.     XS:=XHigh-XLow+1;
  64.     YS:=YHigh-YLow+1;
  65.     GetMem(SW,2*XS*YS + 4);
  66.     { Allocate 2 bytes for each screen position, + 4 for size and position }
  67.     With SW^ Do
  68.      Begin
  69.       XSize:=XS;
  70.       YSize:=YS;
  71.       XPosn:=XLow;
  72.       YPosn:=YLow;
  73.       For I:=0 To YSize-1 Do
  74.         Move(Mem[ScreenBase:((YPosn+I-1)*80+XPosn-1) Shl 1],
  75.              Contents[I*XSize],XSize Shl 1);
  76.       { For each line of the window,
  77.           Move XSize*2 bytes (1 for char, 1 for attribute) into the Contents
  78.                array.  Leave no holes in the array. }
  79.      End;
  80.     SaveWindow:=SW;
  81.   End;
  82.  
  83. Function SaveCurrentWindow: WindowPtr;
  84.   Begin
  85.     SaveCurrentWindow:=SaveWindow(WindowXLo,WindowYLo,WindowXHi,WindowYHi);
  86.   End;
  87.  
  88. Procedure RestoreWindow(WP: WindowPtr; XPos: XTCoord0; YPos: YTCoord0);
  89. { Given a pointer to a WindowRec, restore the contents of the window.  If
  90.   XPos or YPos is 0, use the XPosn or YPosn that the window was originally
  91.   saved with.  If either is nonzero, use it.  Thus a window can be restored
  92.   exactly with  RestoreWindow(wp,0,0);  or its upper left corner can be
  93.   placed at (2,3) with  RestoreWindow(wp,2,3); }
  94.  
  95.   Var
  96.     I: Integer;
  97.  
  98.   Begin
  99.     With WP^ Do
  100.      Begin
  101.       If XPos=0 Then XPos:=XPosn;
  102.       If YPos=0 Then YPos:=YPosn;
  103.       For I:=0 To YSize-1 Do
  104.         Move(Contents[I*XSize],
  105.              Mem[ScreenBase:2*((YPos+I-1)*80+XPos-1)],XSize*2);
  106.       { For each line of the window,
  107.           Move XSize*2 bytes (1 for char, 1 for attribute) from the Contents
  108.                array onto the screen. }
  109.      End;
  110.   End;
  111.  
  112. Procedure DisposeWindow(Var WP: WindowPtr);
  113. { Dispose of a WindowPtr.  The built in procedure Dispose cannot be used,
  114.   because it will deallocate SizeOf(WindowRec) bytes, even though less may
  115.   have been allocated. }
  116.  
  117.   Begin
  118.     With WP^ Do FreeMem(WP,2*XSize*YSize+4);
  119.     WP:=Nil;
  120.   End;
  121.  
  122. Procedure DRestoreWindow(Var WP: WindowPtr; XPos: XTCoord0; YPos: YTCoord0);
  123. { Restore the contents of a window, then dispose of the saved image }
  124.  
  125.   Begin
  126.     RestoreWindow(WP, XPos, YPos);
  127.     DisposeWindow(WP);
  128.   End;
  129.  
  130. Procedure DRestoreCurrentWindow(Var WP: WindowPtr;
  131.                                 XPos: XTCoord0; YPos: YTCoord0);
  132. { Restore the contents of a window, set the current window to fit the restored
  133.   window, and dispose of the saved image.  A similar procedure
  134.   RestoreCurrentWindow could be written by changing DRestoreWindow to
  135.   RestoreWindow in the last line of the procedure, but I have assumed that
  136.   when you select a window area, you are going to modify it, and not want the
  137.   old image }
  138.  
  139.   Begin
  140.     With WP^ Do
  141.      Begin
  142.       If XPos=0 Then XPos:=XPosn;
  143.       If YPos=0 Then YPos:=YPosn;
  144.       Window(XPos,YPos,XPos+XSize-1,YPos+YSize-1);
  145.      End;
  146.     DRestoreWindow(WP, XPos, YPos);
  147.   End;
  148.  
  149. {****** My interface - S. Murphy ******}
  150.  
  151. type
  152.     WindowParms = record
  153.         col1, col2,
  154.         row1, row2 : integer;          {corner co-ordinates}
  155.         frame : 0..2;                  {border type}
  156.         CursorX, CursorY : integer;          {cursor position}
  157.     end;
  158.  
  159.     WindowDescriptor = ^WindowParms;
  160. Var
  161.    StatWin, TermWin,
  162.    CurrentWin, border    : WindowDescriptor;
  163.    TempWin               : WindowPtr;
  164.    StackedPage           : WindowPtr;
  165.  
  166. procedure UsePermWindow(var w : WindowDescriptor);
  167. begin
  168.      with CurrentWin^ do
  169.      begin
  170.           CursorX := WhereX;
  171.           CursorY := WhereY
  172.      end;
  173.      CurrentWin := w;
  174.      with w^ do
  175.      begin
  176.           window(col1,row1,col2,row2);
  177.           GotoXY(CursorX, CursorY)
  178.      end
  179. end;
  180.  
  181. procedure Status(slot :integer; msg : bigstring);
  182. var
  183.    i : integer;
  184. begin
  185.      UsePermWindow(StatWin);
  186.      GotoXY(20*slot+1,1);
  187.      for i := 1 to 20 do
  188.          write(' ');
  189.      GotoXY(20*slot+1,1);
  190.      write(msg);
  191.      UsePermWindow(TermWin)
  192. end;
  193.  
  194.  
  195. procedure InitWindow(var w : WindowDescriptor;
  196.                          x1, y1, x2, y2 : integer);
  197. begin
  198.      new(w);
  199.      with w^ do
  200.      begin
  201.           col1 := x1;
  202.           col2 := x2;
  203.           row1 := y1;
  204.           row2 := y2;
  205.           CursorX := 1;
  206.           CursorY :=1
  207.      end
  208. end;
  209.  
  210. procedure DrawBox(col1, row1, col2, row2, frame : integer);
  211. type
  212.     cvec6 = array[1..6] of char;
  213.     cptr = ^cvec6;
  214. const
  215.      V1 = #179;   UR1 = #191;   UL1 = #218;
  216.      V2 = #186;   UR2 = #187;   UL2 = #201;
  217.      H1 = #196;   LR1 = #217;   LL1 = #192;
  218.      H2 = #205;   LR2 = #188;   LL2 = #200;
  219.  
  220.      SFRAME : cvec6 = (UL1,H1,UR1,V1,LL1,LR1);
  221.      DFRAME : cvec6 = (UL2,H2,UR2,V2,LL2,LR2);
  222.  
  223. var
  224.    framedef : cptr;
  225.    i,j : integer;
  226. begin
  227.      if frame <> 0 then
  228.      begin
  229.           case frame of
  230.              1 : framedef := ptr(seg(SFRAME),ofs(SFRAME));
  231.              2 : framedef := ptr(seg(DFRAME),ofs(DFRAME))
  232.           end;
  233.           GotoXY(col1, row1);
  234.           write(framedef^[1]);
  235.           for i := col1 + 1 to col2 - 1 do
  236.               write(framedef^[2]);
  237.           write(framedef^[3]);
  238.           for i := row1 + 1 to row2 - 1 do
  239.           begin
  240.                 GotoXY(col1, i);
  241.                 write(framedef^[4]);
  242.                 GotoXY(col2, i);
  243.                 write(framedef^[4])
  244.           end;
  245.           GotoXY(col1, row2);
  246.           write(framedef^[5]);
  247.           for i := col1 + 1 to col2 - 1 do
  248.               write(framedef^[2]);
  249.           write(framedef^[6])
  250.     end
  251. end;
  252.  
  253. Procedure OpenTemp(x1,y1,x2,y2,border : integer);
  254. begin
  255.      with CurrentWin^ do
  256.      begin
  257.        CursorX := WhereX;
  258.        CursorY := WhereY;
  259.        TempWin := SaveWindow(col1,row1,col2,row2)
  260.      end;
  261.      DrawBox(x1,y1,x2,y2,border);
  262.      TurboWindow(x1+1, y1+3, x2-1, y2+1);
  263.      ClrScr;
  264.      GotoXY(1,1)
  265. end;
  266.  
  267. Procedure CloseTemp;
  268. begin
  269.      DRestoreWindow(TempWin,0,0);
  270.      with CurrentWin^ do
  271.      begin
  272.         TurboWindow(col1,row1,col2,row2);
  273.         GotoXY(CursorX,CursorY)
  274.      end
  275. end;
  276.  
  277. procedure PushPage;
  278. const
  279.      MEMNEEDED = 3696; {memory overhead to store a page}
  280. Var
  281.    c : char;
  282. begin
  283.      if MemAvail >= MEMNEEDED then
  284.      begin
  285.           OpenTemp(20,5,75,10,2);
  286.           write('Save this screen? (Y/N; default N) ');
  287.           readln(c);
  288.           CloseTemp;
  289.           if c in  ['Y','y'] then
  290.                StackedPage := SaveWindow(1,3,80,25)
  291.      end
  292.      else begin
  293.           OpenTemp(30,5,70,10,2);
  294.           writeln('Out of Memory: Can''t save page.');
  295.           write('Type <cr> to continue.');
  296.           readln
  297.      end
  298. end;
  299.  
  300. procedure PopPage;
  301. begin
  302.      if StackedPage <> NIL then
  303.           DRestoreWindow(StackedPage,0,0)
  304. end;